home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Languages Suite
/
ProgramD2.iso
/
Visual Database
/
Visual dBase v5.5
/
SAMPLES1.PAK
/
WINAPI.WFM
< prev
Wrap
Text File
|
1995-07-18
|
16KB
|
444 lines
*****************************************************************************
* PROGRAM: WinApi.wfm
*
* WRITTEN BY: Borland Samples Group
*
* DATE: 6/28/93
*
* UPDATED: 5/95
*
* REVISION $Revision: 1.57 $
*
* VERSION: Visual dBASE
*
* DESCRIPTION: This program shows how to access useful Windows API functions
* using the Visual dBASE API interface.
* A form is displayed with pushbuttons containing different
* information that can be accessed with the Windows API through
* Visual dBASE. Pressing a pushbutton executes the selected
* function (or series of functions). The Close pushbutton
* closes the window.
*
* PARAMETERS: None
*
* CALLS: Buttons.cc (Custom controls file)
* SysInfo.wfm (Form for displaying system information)
*
* GetWinFlags() (Windows API functions)
* GetModuleUsage()
* GetModuleHandle()
* GetVersion()
* ShowWindow()
* GetFreeSpace()
* SystemParametersInfo()
* MessageBox()
* GetWindowText()
* CloseWindow()
* OpenIcon()
* GetWindowsDirectory()
* GetPrivateProfileString()
*
* USAGE: DO Winapi.wfm
*
*
*
*******************************************************************************
#include <Messdlg.h>
#include <Winapi.h>
#define ENTER chr(13)
#define TAB chr(9)
create session
set talk off
set ldCheck off
** END HEADER -- do not remove this line*
* Generated on 07/11/95
*
parameter bModal
local f
f = new WINAPIFORM()
if (bModal)
f.mdi = .F. && ensure not MDI
f.ReadModal()
else
f.Open()
endif
CLASS WINAPIFORM OF FORM
Set Procedure To &_dbwinhome.samples\BUTTONS.CC additive
this.OnOpen = CLASS::ONOPEN
this.Width = 42.666
this.OnClose = CLASS::ONCLOSE
this.Top = 0.9404
this.MousePointer = 1
this.Left = 33.666
this.ColorNormal = "BTNTEXT/BTNFACE"
this.Text = "Windows API Call Demo"
this.Height = 14.2939
this.Maximize = .F.
this.Minimize = .F.
DEFINE RECTANGLE RECTANGLE1 OF THIS;
PROPERTY;
Width 25.6816,;
Top 0.5391,;
Left 1.3184,;
Text "",;
Height 13.7549
DEFINE PUSHBUTTON SYSINFOBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .T.,;
StatusMessage "Show information about the system.",;
FontSize 6,;
Top 1.0596,;
Left 1.9795,;
Text "System Information",;
Height 1.5869,;
OnClick CLASS::SYSINFO,;
Default .T.
DEFINE PUSHBUTTON OKCANBOXBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Show a message dialog.",;
Top 2.918,;
Left 1.9795,;
Text " Message Box ",;
Height 1.6113,;
OnClick CLASS::OKCANBOX
DEFINE PUSHBUTTON WINWALLPAPERBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Show how the wallpaper can be changed from Visual dBASE.",;
Top 4.7793,;
Left 1.9795,;
Text " Wallpaper ",;
Height 1.5732,;
OnClick CLASS::WINWALLPAPER
DEFINE PUSHBUTTON WINDOWCAPTIONSBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Show the caption of the Visual dBASE frame retrieved from the Api and dBASEWIN.",;
Top 6.6299,;
Left 1.9795,;
Text " Window Captions ",;
Height 1.6045,;
OnClick CLASS::WINDOWCAPTIONS
DEFINE PUSHBUTTON WINDIRECTORYBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Show the Windows home directory.",;
Top 8.4795,;
Left 1.9795,;
Text "Windows Directory ",;
Height 1.5791,;
OnClick CLASS::WINDIRECTORY
DEFINE PUSHBUTTON DBWINICONBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Make Visual dBASE minimized for a short time.",;
Top 10.3389,;
Left 1.9795,;
Text "Icon",;
Height 1.6016,;
OnClick CLASS::ICONIZE
DEFINE PUSHBUTTON WHOAMIBUTTON OF THIS;
PROPERTY;
Width 23.8535,;
Group .F.,;
StatusMessage "Display information about the user.",;
Top 12.1973,;
Left 1.9795,;
Text "Who Am I?",;
Height 1.5674,;
OnClick CLASS::WHOAMI
DEFINE CLOSEBUTTON CLOSEWINAPIBUTTON OF THIS;
PROPERTY;
Width 14.1201,;
Group .T.,;
StatusMessage "Leave Winapi.",;
Top 1.0596,;
Left 28.3799,;
Height 1.5283
DEFINE SAMPLEINFOBUTTON WINAPIINFOBUTTON OF THIS;
PROPERTY;
Width 3.5,;
Group .T.,;
Top 13,;
Left 39,;
Text "",;
Height 1.1758
procedure OnOpen
*******************************************************************************
set procedure to &_dbwinhome.samples\Sampproc.prg additive
this.winapiInfoButton.sampleName = "Winapi.wfm"
*******************************************************************************
procedure OnClose
*******************************************************************************
close procedure &_dbwinhome.samples\Buttons.cc,;
&_dbwinhome.samples\Sampproc.prg
*******************************************************************************
procedure SysInfo
* Bring up form with various system information.
*******************************************************************************
local info
_app.framewin.visible = .F. && if frame invisible at that time
set procedure to &_dbwinhome.samples\Sysinfo.wfm additive
info = new SysInfoForm()
info.Readmodal()
form.visible = .T.
_app.framewin.visible = .T.
close procedure &_dbwinhome.samples\Sysinfo.wfm
*******************************************************************************
function OkCanBox(cMess, cTitle)
* OkCanBox(<cMess>,<cTitle>).
* <cMess> = Message to display in Box.
* <cTitle> = Title of Message Box.
*
* Creates a MessageBox on the SCREEN with
* a title and message text. The user must
* press or click OK or CANCEL or press ESCAPE
* key. This is a System Modal MessageBox.
* Calls the User.exe function MessageBox()
* -- the Borland version of the Windows function MessageBox().
* choice = okcanbox("Read my lips","Message Box")
* 2 if Escape pressed, 1 if OK button pressed,
* 2 if CANCEL pressed. Or 0 if not enough memory.
*******************************************************************************
* Returns 0 if not enough memory to create MessageBox.
* Returns 1=OK,2=CANCEL,3=ABORT,4=RETRY,5=IGNORE,6=YES,7=NO,8=ONE
* wType any combo of below
* MODE DEFAULT BUTTON
*0x3000h=12288D Mode Mask 0x0F00h=3840 Dec Def.Button
*0x0000h=00000D App Modal 0x0000h=0000 Dec Button 1
*0x1000h=04096D Sys Modal 0x0100h=0256 Dec Button 2
*0x2000h=08192D Task Modal 0x0200h=0512 Dec Button 3
* 0x0300h=0768 Dec Button 4
* 0x0400h=1024 Dec Button 5
* 0x0500h=1280 Dec Button 6
* 0x0600h=1536 Dec Button 7
* 0x0700h=1792 Dec Button 8
* ICON BUTTON
*0x00F0h=0240D Icon Mask 0x000Fh=0015Dec Type Mask
*0x0010h=0016D Hand 0x0000h=0000Dec OK Button
*0x0010h=0016D Stop * 0.00x0001h=0001Dec OK CANCEL
*0x0020h=0032D Question 0x0002h=0002Dec ABORT RETRY IGNORE
*0x0030h=0048D Exclaimation 0003h=0003Dec YES NO CANCEL
*0x0040h=0064D Astrisk 0x0004h=0004Dec YES NO
*0x0040h=0064D Information x0005h=0005Dec RETRY CANCEL
* 0x0008h=0008Dec ABORT RETRY
* 0x0009h=0009Dec OK CANCEL ABORT
* RETRY IGNORE
* 0x000Ah=0010Dec NO CANCEL RETRY
* CANCEL GARBAGE
* 0x000Bh=0011Dec OK CANCEL ABORT
* RETRY IGNORE YES
* NO CANCEL
*******************************************************************************
private cMess1, cTitle1, value
cMess1 = iif(empty(cMess),;
FormatStr("Put Message Here! \n" +;
"Syntax is: \n" +;
"? OkCanBox('Message','Title') \n\n" +;
"Returns: \n" +;
"1 if OK button clicked or pressed \n" +;
"2 if Cancel button or Escape key pressed \n" +;
"0 if not enough memory to run"),;
cMess)
cTitle1 = iif(empty(cTitle),"OkCanBox( ) Message Function",cTitle)
value = MessageBox(0,;
ansi(cMess1),;
ansi(cTitle1),;
INFORMATION_MESSAGE + OK_CANCEL_BUTTONS)
?value
return value
*******************************************************************************
procedure WinWallpaper
* Calls the Windows WallPaper changer program.
* First it reduces Visual dBASE to an icon, then it
* changes into the Windows directory and displays a
* GETFILE() box of the *.BMP files in the Windows
* directory then it changes the desktop wallpaper to
* the file you choose.Next it asks if you want to keep
* the Wallpaper or set it to (None) Then it returns to
* the directory you started from and restores Visual dBASE
* from the icon.
*******************************************************************************
* extern CLOGICAL SystemParametersInfo (CINT, CINT, CPTR, CINT) USER
* extern CVOID CloseWindow(CHANDLE) USER
private wallpaper,newWall,orgDir,winPath,changeWallStr
_app.framewin.visible = .F.
orgDir = set("directory")
winPath = CLASS::winDirectory(.T.)
cd &winPath
wallpaper = getfile("*.BMP","Select New Wallpaper")
cd &orgDir
changeWallStr = FormatStr("Press OK to change the Wallpaper \n;
or press Cancel to keep your original wallpaper")
if .not. empty(wallpaper) .and. CLASS::OkCanBox(changeWallStr) = OK
SystemParametersInfo(20,0,ansi(wallpaper),1)
endif
_app.framewin.visible = .T.
this.SetFocus()
*******************************************************************************
procedure WindowCaptions
* Calls the Windows function GetFormText to get title of the
* Visual dBASE frame window
*******************************************************************************
* extern CINT GetWindowText (CHANDLE, CSTRING, CINT) USER
local winTitle,lenTitle,apiStr,objectStr
winTitle = space(80) && first make empty string to be filled
lenTitle = GetWindowText(_app.framewin.hwnd,winTitle,80)
apiStr = FormatStr("From API call:\t %1", oem(winTitle))
objectStr = FormatStr("From Visual dBASE:\t %1", (_app.framewin.text))
MessageBox(0,;
ansi(apiStr + ENTER + objectStr),;
ansi("Title of Visual dBASE"),;
INFORMATION_MESSAGE + OK_BUTTON)
*******************************************************************************
procedure Iconize
* This example just minimizes Visual dBASE to a
* ICON (by way of the CloseWindow funtion) waits 5
* seconds then restores Visual dBASE from its icon.
*
*******************************************************************************
* extern CWORD CloseWindow(CWORD) USER
* extern CWORD OpenIcon(CWORD) USER
local frameState
if messageBox(0,;
ansi("This will minimize Visual dBASE for 5 seconds. Proceed?"),;
ansi("Confirmation"),;
CONFIRMATION_MESSAGE + YES_NO_BUTTONS) = YES
frameState = _app.framewin.windowState + 1 && Save previous frame state
CloseWindow(_app.framewin.hwnd) && Reduce Visual dBASE to icon
inkey(5) && Wait 5 seconds
ShowWindow(_app.framewin.hwnd,frameState) && Restore Visual dBASE
&& from an icon
endif
*******************************************************************************
function WinDirectory(dontShowBox)
* Calls the Windows Funnction GetWindowsDirectory( ) which
* is used to get the Directory that Windows is
* installed in.
*
*******************************************************************************
* extern CWORD GetWindowsDirectory(CSTRING, CWORD) KERNEL
local cWinDir
cWinDir = space(144)
GetWindowsDirectory(cWinDir,144)
if .not. dontShowBox
MessageBox(0,;
cWinDir,;
ansi("Windows Directory"),;
INFORMATION_MESSAGE + OK_BUTTON)
endif
return oem(cWinDir)
*******************************************************************************
procedure WhoAmI
* Displays Windows and Visual dBASE registration information.
*******************************************************************************
* extern CWORD GetPrivateProfileString;
* (CSTRING, CPTR, CPTR, CPTR, CWORD, CPTR) KERNEL
* extern CWORD MessageBox (CWORD, CPTR, CPTR, CWORD) USER
local cUser, cComp, nUserLen, nOrgLen, cIniDir, cWinUsr, cWinComp,;
nWinUsr, nWinComp
cWinUsr = rtrim( oem(Resource( 514, "USER.EXE" )) )
cWinComp = rtrim( oem(Resource( 515, "USER.EXE" )) )
cUser = space( 50 )
cComp = space( 50 )
cIniDir = _dbwinhome + "BIN\DBASEWIN.INI"
nUserLen = GetPrivateProfileString( "Install","Username",'Unknown',cUser,50,;
cIniDir)
nCompLen = GetPrivateProfileString( "Install","Company",'Unknown', cComp,50,;
cIniDir)
nWinUsr = len( cWinUsr )
nWinComp = len( cWinComp )
cUser = iif( nUserLen = 0, 'Unknown', left( oem(cUser), nUserLen ) )
cComp = iif( nCompLen = 0, 'Unknown', left( oem(cComp), nCompLen ) )
cWinUsr = iif( nWinUsr = 0, 'Unknown', cWinUsr )
cWinComp = iif( nWinComp = 0, 'Unknown', cWinComp )
MessageBox(0,; && Display window
ansi(FormatStr("Visual dBASE Registered to:\n"+ ; && Message
" Customer Name: \t %1 \n" + ;
" User Company: \t %2 \n\n" + ;
"Windows Registered to:\n" + ;
" Customer Name: \t %3 \n" + ;
" User Company: \t %4", ;
cUser, cComp, cWinUsr, cWinComp)), ;
ansi("Visual dBASE User Information"), ; && Title
INFORMATION_MESSAGE + OK_BUTTON) && Window Style
ENDCLASS